Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d18/ng_clone.arc/NG_CLONE.PAS

Pascal/Delphi Source File | 1991-04-28 | 53KB | 1,385 lines

{$M 4096,0,0}                                    {Reduce stack and heap}
{$R-,I-}                                            {Cut off range and I/O checking}

program ng_clone;                            {After all, that's what it is; Thank you, Mr. Norton, you are among my heroes!}

uses    crt,tesstp5;                        {TESS could probably be the 4.0 version also}

type    gentry=    record                    {General entry type}
                                filptr:longint;
                                name:string[40];
                            end;
            textel=    record                    {Text-mode screen element}
                                cha:byte;
                                att:byte;
                            end;
            fiftylinebuf=    array[1..50,1..80] of textel;        {Video buffer types}
            twelwebuf=    array[1..12,1..80] of textel;
            savedline=    array[1..80] of textel;

var    screen:fiftylinebuf absolute $B800:$0000;                {Text-mode screen, should be B000:0000h on monochrome}
        csr:word absolute $0040:$0060;                                    {Low-memory cursor info}
        screenmode:word absolute $0040:$0049;                        {Low-memory screen info}
        numrows:word absolute $0040:$0084;                            {Low-memory screen info}
        savedscreen:fiftylinebuf;                                                {Buffer to save current screen on entry}
        smallscreen:twelwebuf;                                                    {Buffer to hold screen template}
        menuline:array[0..1] of savedline;                            {Buffer to hold screen template}
        largescreen:array[0..1] of savedline;                        {Buffer to hold screen template}
        scrollbuffer:array[0..511] of string[84];                {Buffer to hold guide text entry}
        infobuffer:array[0..511] of longint;                        {Buffer to hold guide file info}
        seealso:array[0..19] of gentry;                                    {Buffer to hold guide file info}
        menu:array[0..2] of string[9]; {Buffer to hold static part of guide menu structure}
        mennu:array[0..3,0..8] of gentry;  {Buffer to hold variable part of guide menu structure}
        backstack:array[0..3] of byte;                                    {TESS background stack}
        itemlist:array[0..3] of byte;                                        {Menu structure info}
        menuplaces,menulengths:array[0..6] of byte;            {Stacks for nested menu structures}
        errorinfo:array[3..6] of string[14];                        {Buffer for error messages}
        f:file;                                                                                    {The guide file}
        propath,homedir,streng:string;                                    {String variables, mostly for path and file use}
        tsrstring:string[8];                                                        {TESS ID string}
        parent:array[0..3] of longint;                                    {Stack for nested menu structures}
        poffset:array[0..3] of word;                                        {Stack for nested menu structures}
        pcurpos:array[0..3] of byte;                                        {Stack for nested menu structures}
        defptr,stackptr:pointer;                                                {TESS pointers}
        previous,next:longint;                                                    {Previous and next entry}
        idnum,i,j,offset,ch,id,bufferlength,savedcsr:word;        {Word variables}
        erro,wix,wiy,curpos,entrytype,seealsonum,sapos,level,scrtypeflag,startline,
        txtattri,a1,a2,a3,a4,mlevel,xchoice,ychoice,menux,menuy,menuantal,menunr:byte;        {Byte variables}

procedure hidecrsr; {Make cursor invisible on CGA,EGA or VGA}
begin
    inline($B4/$01/$B5/$20/$CD/$10);
end;

function restorecrsr(crsr:word):boolean;                        {Restore saved cursor on CGA,EGA or VGA}
    inline($B4/$01/$59/$CD/$10);

function key:word;                                                                    {Keyboard interrupt}
    inline($CD/$16);

procedure keyread(var karakter:word);                                {Readkey replacement}
var tch:char;
begin
    karakter:=key;
    if (lo(karakter)=0) then {If extended key, add 256 to value of key code}
    begin
        tch:=char(hi(karakter));
        karakter:=ord(tch)+256;
    end
    else {Else return key code as is}
    begin
        tch:=char(lo(karakter));
        karakter:=ord(tch);
    end;
end;

procedure writestring(cux,cuy,startattr,change,extra:byte;cus:string);        {Direct screen write}
var jcount,ycount,tmpchr:byte;
        jch:char;
begin
    jcount:=0;ycount:=0;txtattri:=startattr;
    repeat
        inc(jcount);
        jch:=cus[jcount];
        if jch<>'^' then                                                    {If not NG control code, write character as is}
        begin
            if jch=#255 then                                                {Expand spaces}
            begin
                inc(jcount);
                jch:=cus[jcount];
                for ycount:=ycount to ycount+ord(jch) do
                begin
                    screen[cuy,cux+ycount].cha:=32;
                    screen[cuy,cux+ycount].att:=txtattri;
                end;
            end
            else
            begin
                screen[cuy,cux+ycount].cha:=ord(jch);
                screen[cuy,cux+ycount].att:=txtattri;
                inc(ycount);
            end;
        end
        else                                                                            {Control code found!}
        begin
            inc(jcount);
            jch:=cus[jcount];
            if ((jch='A') or (jch='a')) then                {Color attribute command}
            begin
                inc(jcount);
                jch:=cus[jcount];
                if change=1 then
                begin
                    if ((ord(jch)>47) and (ord(jch)<58)) then txtattri:=ord(jch)-48 else
                    if ((ord(jch)>64) and (ord(jch)<71)) then txtattri:=ord(jch)-55;
                    txtattri:=16*txtattri;
                end;
                inc(jcount);
                jch:=cus[jcount];
                if change=1 then
                begin
                    if ((ord(jch)>47) and (ord(jch)<58)) then txtattri:=txtattri+ord(jch)-48 else
                    if ((ord(jch)>64) and (ord(jch)<71)) then txtattri:=txtattri+ord(jch)-55;
                end;
            end
            else if ((jch='C') or (jch='c')) then        {Difficult character}
            begin
                inc(jcount);
                jch:=cus[jcount];
                if ((ord(jch)>47) and (ord(jch)<58)) then tmpchr:=ord(jch)-48 else
                if ((ord(jch)>64) and (ord(jch)<71)) then tmpchr:=ord(jch)-55;
                tmpchr:=16*tmpchr;
                inc(jcount);
                jch:=cus[jcount];
                if ((ord(jch)>47) and (ord(jch)<58)) then tmpchr:=tmpchr+ord(jch)-48 else
                if ((ord(jch)>64) and (ord(jch)<71)) then tmpchr:=tmpchr+ord(jch)-55;
                screen[cuy,cux+ycount].cha:=tmpchr;
                screen[cuy,cux+ycount].att:=txtattri;
                inc(ycount);
            end
            else if ((jch='b') or (jch='B')) then        {Boldface (?)}
            begin
                if change=1 then
                begin
                    if txtattri=a1 then txtattri:=a3 else txtattri:=a1;
                end;
            end
            else if ((jch='u') or (jch='U')) then        {Underline (?)}
            begin
                if change=1 then
                begin
                    if txtattri=a1 then txtattri:=a2 else txtattri:=a1;
                end;
            end
            else if jch='^' then                                        {Write control character itself}
            begin
                screen[cuy,cux+ycount].cha:=ord(jch);
                screen[cuy,cux+ycount].att:=txtattri;
                inc(ycount);
            end;
        end;
    until jcount>=length(cus);
    if extra>0 then                                                            {If desired, fill with blanks}
    begin
        while ycount<extra do
        begin
            screen[cuy,cux+ycount].cha:=32;
            screen[cuy,cux+ycount].att:=txtattri;
            inc(ycount);
        end;
    end;
end;

procedure threenitvars;                                                {Initialize variables}
begin
    menunr:=0;
    level:=0;
    curpos:=0;
    offset:=0;
    menux:=3;
    menuy:=0;
    mlevel:=0;
    xchoice:=0;
    ychoice:=0;
    sapos:=0;
    wix:=0;wiy:=0;
    txtattri:=a1;
end;

procedure twonitvars;                                                    {Initialize variables}
begin
    threenitvars;
    menuplaces[0]:=5;
    menuplaces[1]:=15;
    menuplaces[2]:=28;
    menuplaces[3]:=39;
    menuplaces[4]:=0;
    menuplaces[5]:=0;
    menuplaces[6]:=0;
    menulengths[0]:=20;
    menulengths[1]:=20;
    menulengths[2]:=20;
    menulengths[3]:=0;
    menulengths[4]:=0;
    menulengths[5]:=0;
    menulengths[6]:=0;
    for j:=2 to 79 do smallscreen[1,j].cha:=205;
    for j:=2 to 79 do smallscreen[2,j].cha:=0;
end;

procedure initvars;                                                        {Initialize variables}
var str5:string;
begin
    a1:=$70;                                                                            {Color attribute for normal text}
    a2:=$7E;                                                                            {Color attribute for underline}
    a3:=$7F;                                                                            {Color attribute for boldface}
    a4:=$1E;                                                                            {Cursor color attribute}
    startline:=0;
    scrtypeflag:=0;
    twonitvars;
    errorinfo[3]:='File not found';
    errorinfo[4]:='Not an NG file';
    errorinfo[5]:='Unexpected EOF';
    errorinfo[6]:='Corrupted file';
    menu[0]:='Expand';
    menu[1]:='Search...';
    menu[2]:='Options';
    str5:='';propath:=paramstr(0);
    while (pos('\',propath)>0) do
    begin
        str5:=str5+copy(propath,1,pos('\',propath));
        propath:=copy(propath,pos('\',propath)+1,length(propath)-(pos('\',propath)+1));
    end;
    propath:=str5;
end;

procedure initscreen;                                                    {Read screen template from disk}
var sf:file;
        numread:word;
begin
    assign(sf,propath+'ng_clone.scr');
    reset(sf,1);
    blockread(sf,smallscreen,sizeof(smallscreen),numread);
    blockread(sf,menuline[1],sizeof(menuline[1]),numread);
    for i:=1 to 80 do largescreen[0,i]:=smallscreen[5,i];
    for i:=1 to 80 do largescreen[1,i]:=smallscreen[11,i];
    close(sf);
end;

procedure removecursor;                                                {Next follows different cursor procedures}
var sl:byte;
begin
    if scrtypeflag=0 then sl:=startline else sl:=0;
    writestring(2,4+curpos+sl,a1,1,78,scrollbuffer[curpos+offset]);
end;

procedure insertcursor;                                                {Another cursor procedure}
var sl:byte;
begin
    if scrtypeflag=0 then sl:=startline else sl:=0;
    writestring(2,4+curpos+sl,a4,0,78,scrollbuffer[curpos+offset]);
end;

procedure removemenucursor;                                        {Another cursor procedure}
var sl:byte;
        cursor:string[78];
begin
    if scrtypeflag=0 then sl:=startline else sl:=0;
    if menux>2 then cursor:=' '+mennu[menux-3,0].name+' ' else
    cursor:=' '+menu[menux]+' ';
    writestring(menuplaces[menux]-1,2+sl,txtattri,0,0,cursor);
end;

procedure insertmenucursor;                                        {Another cursor procedure}
begin
    txtattri:=a4;
    removemenucursor;
    txtattri:=a1;
end;

procedure movemenucursor(direction:byte);            {Another cursor procedure}
var sl:byte;
begin
    if ((entrytype=1) or (level=0)) then
    begin
        if scrtypeflag=0 then sl:=startline else sl:=0;
        txtattri:=a3;
        removemenucursor;
        if direction=0 then
        begin
            if menux>0 then dec(menux) else menux:=2+menuantal;
        end
        else
        begin
            if menux<2+menuantal then inc(menux) else menux:=0;
        end;
        insertmenucursor;
        for j:=1 to 80 do menuline[0][j]:=screen[2+sl,j];
    end;
end;

procedure removemlcursor;                                            {Another cursor procedure}
var    cursor:string[78];
begin
    if ((menux-3=xchoice) and (menuy=ychoice)) then cursor:=#251+' '+mennu[menux-3,menuy+1].name else
    cursor:='  '+mennu[menux-3,menuy+1].name;
    while length(cursor)<menulengths[menux]+3 do cursor:=cursor+' ';
    writestring(2+wix,2+menuy+wiy,txtattri,0,0,cursor);
end;

procedure insertmlcursor;                                            {Another cursor procedure}
begin
    txtattri:=a4;
    removemlcursor;
    txtattri:=a1;
end;

procedure removeseealso;                                            {Another cursor procedure}
var addo,sl:byte;
        cursor:string[78];
begin
    addo:=0;
    if scrtypeflag=0 then sl:=startline else sl:=0;
    for j:=0 to sapos do
    begin
        if j>0 then inc(addo,length(seealso[j-1].name)+2);
    end;
    cursor:=' '+seealso[sapos].name+' ';
    writestring(13+addo,2+sl,txtattri,0,0,cursor);
end;

procedure insertseealso;                                            {Another cursor procedure}
begin
    txtattri:=a4;
    removeseealso;
    txtattri:=a1;
end;

procedure moveseealso(direction:byte);                {You'd never guess: another cursor procedure}
begin
    if seealsonum<>255 then
    begin
        removeseealso;
        if direction=0 then
        begin
            if sapos>0 then dec(sapos) else sapos:=seealsonum;
        end
        else
        begin
            if sapos<seealsonum then inc(sapos) else sapos:=0;
        end;
        insertseealso;
    end;
end;

procedure frame1(w,d:byte);                                        {Frame of line-drawing charcters used for menu}
begin
    writestring(wix+1,wiy+1,a1,0,0,' ');
    for i:=2 to d-1 do
    begin
        writestring(1+wix,i+wiy,a1,0,0,' ');
        writestring(w+wix,i+wiy,a1,0,0,' ');
    end;
    writestring(wix+1,wiy+d,a1,0,0,' ');
    for i:=2 to w-1 do writestring(wix+i,wiy+d,a1,0,0,' ');
    writestring(wix+i+1,wiy+1,a1,0,0,' ');
    writestring(wix+i+1,wiy+d,a1,0,0,' ');
end;

procedure createsmall;                                                {Save current screen and create small screen}
begin
    savedscreen:=screen;
    hidecrsr;
    for i:=1 to 12 do for j:=1 to 80 do screen[i+startline,j]:=smallscreen[i,j];
    writestring(5,2+startline,a3,0,0,menu[0]);
    writestring(15,2+startline,a3,0,0,menu[1]);
    writestring(28,2+startline,a3,0,0,menu[2]);
    writestring(39,2+startline,a3,0,0,mennu[0,0].name);
    if menuantal>1 then
    begin
        i:=length(mennu[0,0].name);
        menuplaces[4]:=43+i;
        writestring(43+i,2+startline,a3,0,0,mennu[1,0].name);
    end;
    if menuantal>2 then
    begin
        inc(i,length(mennu[1,0].name));
        menuplaces[5]:=47+i;
        writestring(47+i,2+startline,a3,0,0,mennu[2,0].name);
    end;
    if menuantal>3 then
    begin
        inc(i,length(mennu[2,0].name));
        menuplaces[6]:=51+i;
        writestring(51+i,2+startline,a3,0,0,mennu[3,0].name);
    end;
    i:=0;
    while ((i<bufferlength+1) and (i<8)) do
    begin
        writestring(2,4+i+startline,a1,1,78,scrollbuffer[i]);inc(i);
    end;
    for i:=1 to 12 do for j:=1 to 80 do smallscreen[i,j]:=screen[i+startline,j];
    insertmenucursor;
    screen[5+startline,80].att:=$40;
    for j:=1 to 80 do menuline[0][j]:=screen[2+startline,j];
end;

procedure blank(width,height:byte);                        {Blank part of screen}
begin
    for i:=2 to height do for j:=1 to width do
    begin
        screen[wiy+i,wix+j].att:=a1;
        screen[wiy+i,wix+j].cha:=0;
    end;
end;

procedure makemenu(num:byte);                                    {Make pull-down menu}
var windstart,sl:byte;
begin
    if scrtypeflag=0 then sl:=startline else sl:=0;
    if (menulengths[num]+menuplaces[num]+5>79) then windstart:=79-(menulengths[num]+5) else windstart:=menuplaces[num]-2;
    wix:=windstart-1;wiy:=2+sl;
    blank(menulengths[num]+4,itemlist[num-3]+1);
    frame1(menulengths[num]+5,1+itemlist[num-3]);
    for i:=1 to itemlist[num-3]-1 do
    begin
        writestring(4+wix,1+i+wiy,a1,0,0,mennu[num-3,i].name);
    end;
    if num-3=xchoice then
    begin
        writestring(2+wix,2+ychoice+wiy,a1,0,0,#251);
    end;
    insertmlcursor;
    mlevel:=1;
end;

procedure writeseealsos(possible_offset:byte);        {Write seealso entries}
var satmp:word;
begin
    if seealsonum<>255 then
    begin
        j:=0;satmp:=0;
        for i:=0 to seealsonum do
        begin
            writestring(14+j,2+possible_offset,a1,0,0,seealso[i].name);
            inc(j,length(seealso[i].name)+2);
            if i<seealsonum then
            begin
                if (15+j+length(seealso[i+1].name)>79) then
                begin
                    satmp:=i;
                    i:=seealsonum;
                end
                else satmp:=0;
            end;
        end;
        if satmp>0 then seealsonum:=satmp;
        insertseealso;
    end;
end;

procedure makesmall(vertical_offset:byte);        {Repaint small screen}
begin
    if ((entrytype=1) or (level=0)) then
    begin
        for i:=1 to vertical_offset do for j:=1 to 80 do screen[i,j]:=savedscreen[i,j];
        for j:=1 to 80 do screen[vertical_offset+1,j]:=smallscreen[1,j];
        for j:=1 to 80 do screen[vertical_offset+2,j]:=menuline[0][j];
        for i:=3 to 12 do for j:=1 to 80 do screen[i+vertical_offset,j]:=smallscreen[i,j];
        for i:=(13+vertical_offset) to lo(numrows)+1 do for j:=1 to 80 do screen[i,j]:=savedscreen[i,j];
    end
    else
    begin
        for i:=1 to vertical_offset do for j:=1 to 80 do screen[i,j]:=savedscreen[i,j];
        for j:=1 to 80 do screen[vertical_offset+1,j]:=smallscreen[1,j];
        for j:=1 to 80 do screen[vertical_offset+2,j]:=menuline[1][j];
        for i:=3 to 12 do for j:=1 to 80 do screen[i+vertical_offset,j]:=smallscreen[i,j];
        for i:=(13+vertical_offset) to lo(numrows)+1 do for j:=1 to 80 do screen[i,j]:=savedscreen[i,j];
        writeseealsos(vertical_offset);
    end;
    if entrytype=1 then
    begin
        if curpos>7 then
        begin
            inc(offset,curpos-7);
            curpos:=7;
        end;
    end;
    if entrytype=1 then insertcursor;
    for i:=5 to 10 do screen[i+vertical_offset,80].att:=$07;
    i:=(((curpos+offset)*6) div (bufferlength+1))+5;
    if i>10 then i:=10;
    screen[i+vertical_offset,80].att:=$40;
end;

procedure makelarge;                                                    {Repaint large screen}
var    add:byte;
begin
    if ((entrytype=1) or (level=0)) then
    begin
        for j:=1 to 80 do screen[1,j]:=smallscreen[1,j];
        for j:=1 to 80 do screen[2,j]:=menuline[0][j];
        for i:=3 to 10 do for j:=1 to 80 do screen[i,j]:=smallscreen[i,j];
        for i:=11 to lo(numrows)-1 do for j:=1 to 80 do screen[i,j]:=largescreen[0,j];
        for j:=1 to 80 do screen[lo(numrows),j]:=largescreen[1,j];
        for j:=1 to 80 do screen[lo(numrows)+1,j]:=smallscreen[12,j];
    end
    else
    begin
        for j:=1 to 80 do screen[1,j]:=smallscreen[1,j];
        for j:=1 to 80 do screen[2,j]:=menuline[1][j];
        for i:=3 to 10 do for j:=1 to 80 do screen[i,j]:=smallscreen[i,j];
        for i:=11 to lo(numrows)-1 do for j:=1 to 80 do screen[i,j]:=largescreen[0,j];
        for j:=1 to 80 do screen[lo(numrows),j]:=largescreen[1,j];
        for j:=1 to 80 do screen[lo(numrows)+1,j]:=smallscreen[12,j];
        writeseealsos(0);
    end;
    if offset+lo(numrows)-4>bufferlength then
    begin
        if bufferlength>offset+lo(numrows)-4 then
        begin
            add:=offset-bufferlength+lo(numrows)-4;
            inc(curpos,add);
            offset:=bufferlength-lo(numrows)+4;
        end
        else
        begin
            inc(curpos,offset);
            offset:=0;
        end;
    end;
    i:=0;
    while ((i+offset<bufferlength+1) and (i<lo(numrows)-3)) do
    begin
        writestring(2,4+i,a1,1,78,scrollbuffer[i+offset]);inc(i);
    end;
    if i<lo(numrows)-3 then for i:=i to lo(numrows)-4 do
    begin
        writestring(2,4+i,a1,0,78,' ');
    end;
    if entrytype=1 then
    begin
        if curpos>7 then add:=curpos-7 else add:=0;
    end
    else
    begin
        add:=0;
    end;
    for i:=4 to 11 do for j:=2 to 79 do smallscreen[i,j]:=screen[i+add,j];
    if entrytype=1 then insertcursor;
    for i:=5 to lo(numrows)-1 do screen[i,80].att:=$07;
    i:=(((curpos+offset)*(lo(numrows)-5)) div (bufferlength+1))+5;
    if i>lo(numrows)-1 then i:=lo(numrows)-1;
    screen[i,80].att:=$40;
    if mlevel=1 then makemenu(menux);
end;


procedure usage;                                                            {Write usage info}
begin
    writeln('NG_CLONE USAGE   :');
    writeln('------------------');
    writeln;
    writeln('  ng_clone <'+#123+'d:\dir\'+#125+'file'+#123+'.ext'+#125+'> '+#123+
    '<d:\ngdir>'+#125+' <+/->  :run NG_CLONE (see below)');
    writeln('  ng_clone </u> or </U>                           :remove NG_CLONE if resident');
    writeln('  ng_clone </?> or </h> or </H>                   :show this usage information');
    writeln;
    writeln('  The +/- entry is NOT optional, but  used by NG_CLONE to determine whether or');
    writeln('  not to install itself as a resident program.');
end;

procedure slutlort(b:byte);                                        {Exit on error and display relevant error message}
begin
    if b>3 then close(f);
    if b>2 then
    begin
        write('NG_CLONE ERROR #');write(b);writeln(': '+errorinfo[b]+', cannot proceed');
    end;
    if b<3 then usage;
    halt(0);
end;

procedure sllut(b:byte); {Error handler without exit, just indicating the error type}
var sl:byte;
begin
    if scrtypeflag=0 then sl:=startline else sl:=0;
    if b>3 then close(f);
    writestring(4,4+sl,a1,0,74,' '+errorinfo[b]+' - Press any key');
    erro:=1;
end;

function decrypt(b:byte):byte;                                {Decrypt byte from NG format}
begin
    if ((b mod 32)>=16) then b:=b-16 else b:=b+16;
    if ((b mod 16)>=8) then b:=b-8 else b:=b+8;
    if ((b mod 4)>=2) then b:=b-2 else b:=b+2;
    decrypt:=b;
end;

function read_byte:byte;                                            {Read and decrypt byte}
var tb:byte;
        numread:word;
begin
    blockread(f,tb,1,numread);
    tb:=decrypt(tb);
    read_byte:=tb;
end;

function read_word:word;                                            {Read and decrypt word}
var tw:word;
        tb:byte;
begin
    tb:=read_byte;
    tw:=tb;
    tb:=read_byte;
    inc(tw,(tb*256));
    read_word:=tw;
end;

function read_long:longint;                                        {Read and decrypt longint}
var tl:longint;
        tw:word;
begin
    tw:=read_word;
    tl:=tw;
    tw:=read_word;
    inc(tl,(tw*65536));
    read_long:=tl;
end;

procedure read_menu;                                                    {Read a menu structure into the menu buffer}
var items:word;
begin
    mennu[menunr,0].filptr:=filepos(f)-2;
    seek(f,filepos(f)+2);
    items:=read_word;
    itemlist[menunr]:=items;
    seek(f,filepos(f)+20);
    for i:=1 to items-1 do
    begin
        mennu[menunr,i].filptr:=read_long;
    end;
    i:=filepos(f);
    inc(i,(items*8));
    seek(f,i);
    for i:=0 to items-1 do
    begin
        j:=0;
        repeat
            mennu[menunr,i].name[j+1]:=chr(read_byte);
            inc(j);
        until (mennu[menunr,i].name[j]=#0);
        mennu[menunr,i].name[0]:=chr(j-1);
        if j-1>menulengths[menunr+3] then menulengths[menunr+3]:=j-1;
    end;
    seek(f,filepos(f)+1);
end;

procedure skip_short_long;                                        {Skip procedure for the initial menu seek}
var length:word;
begin
    length:=read_word;
    seek(f,filepos(f)+22+length);
end;

procedure read_header(modf:byte); {Read NG file header and enter the guide name in the screen template}
var guidenavn:string;
        buf:array[0..377] of byte;
        numread:word;
begin
    blockread(f,buf,sizeof(buf),numread);
    if ((buf[0]<>78) or (buf[1]<>71)) then {If the two first characters in the file are not 'NG', the file is no guide}
    begin
        if modf=0 then slutlort(4) else sllut(4);
    end;
    menuantal:=buf[6];
    i:=0;
    repeat
        guidenavn[i+1]:=chr(buf[i+8]);
        inc(i);
    until (buf[i+8]=0);
    guidenavn[0]:=chr(i);
    guidenavn:=' The Norton Guide to '+guidenavn+' ';
    for i:=1 to length(guidenavn) do
    begin
        smallscreen[1,39-(length(guidenavn) div 2)+i].cha:=ord(guidenavn[i]);
    end;
    seek(f,378);
end;

procedure read_menus(modf:byte);                            {Initial menu seek, indexing the whole file}
begin
    repeat
        id:=read_word;
        if id<2 then skip_short_long
        else
        if id=2 then
        begin
            read_menu;
            inc(menunr);
        end
        else
        if (id<>5) then
        begin
            if (filesize(f)<>filepos(f)) then
            begin
                if modf=0 then slutlort(5) else sllut(5);        {NG file error}
            end
            else id:=5;
        end;
    until (id=5);
    if (menunr<>menuantal) then
    begin
        if modf=0 then slutlort(6) else sllut(6);                {Incomplete file}
    end;
end;

procedure read_strings(totnum:word);                    {Read null-terminated strings into scroll buffer}
var stringchar:byte;
begin
    for i:=1 to totnum do
    begin
        j:=0;
        repeat
            stringchar:=read_byte;
            inc(j);
            scrollbuffer[i-1][j]:=chr(stringchar);
        until stringchar=0;
        scrollbuffer[i-1][0]:=chr(j-1);
    end;
    bufferlength:=totnum-1;
    for j:=bufferlength+1 to 511 do scrollbuffer[j]:='';
end;

procedure read_short_entry; {Read short entry from file and wring some information out of it}
var items:word;
begin
    seek(f,filepos(f)+2);
    items:=read_word;
    seek(f,filepos(f)+20);
    for i:=1 to items do
    begin
        seek(f,filepos(f)+2);
        infobuffer[i-1]:=read_long;
    end;
    read_strings(items);
    entrytype:=1;
end;

procedure read_long_entry;                                        {Read long entry information}
var linens,dlength,seealso_num:word;
        prev,nxt:longint;
        stringchar:byte;
begin
    seek(f,filepos(f)+2);
    linens:=read_word;
    dlength:=read_word;
    seek(f,filepos(f)+10);
    prev:=read_long;
    nxt:=read_long;
    read_strings(linens);
    if dlength<>0 then                                                        {If there are seealso entries, read them}
    begin
        seealso_num:=read_word;
        for i:=1 to seealso_num do
        begin
            if i<21 then seealso[i-1].filptr:=read_long else seek(f,filepos(f)+4);
        end;
        for i:=1 to seealso_num do
        begin
            if i<21 then
            begin
                j:=0;
                repeat
                    stringchar:=read_byte;
                    inc(j);
                    seealso[i-1].name[j]:=chr(stringchar);
                until stringchar=0;
                seealso[i-1].name[0]:=chr(j-1);
            end;
        end;
        seealsonum:=seealso_num-1;
        if seealsonum>19 then seealsonum:=19;
    end
    else seealsonum:=255;
    entrytype:=2;
    previous:=prev;
    next:=nxt;
end;

procedure read_entry(fp:longint);                            {Read some kind of file entry}
begin
    seek(f,fp);
    id:=read_word;
    case id of
        0:    read_short_entry;
        1:    read_long_entry;
    end;
    if ((id=0) or (level=0)) then parent[level]:=fp;
end;

procedure scrollinsert(addo_ins,directf:byte);        {Insert for the scroll procedure}
var sl:byte;
begin
    if scrtypeflag=0 then sl:=startline else sl:=0;
    if directf=0 then dec(offset) else inc(offset);
    for i:=0 to addo_ins-1 do
    begin
        writestring(2,4+i+sl,a1,1,78,scrollbuffer[i+offset]);
    end;
end;

procedure scroll(direction:byte);                            {Scroll text screen}
var addo,sl:byte;
begin
    addo:=(scrtypeflag*13)+8;
    if scrtypeflag=0 then sl:=startline else sl:=0;
    if scrtypeflag=1 then inc(addo,lo(numrows)-24);
    if entrytype=1 then
    begin
        removecursor;
        if direction=0 then
        begin
            if curpos>0 then
            begin
                dec(curpos);
            end
            else
            begin
                if offset>0 then scrollinsert(addo,0);
            end;
        end
        else
        begin
            if curpos<addo-1 then
            begin
                if curpos<bufferlength then
                begin
                    inc(curpos);
                end;
            end
            else
            begin
                if offset+addo<bufferlength+1 then scrollinsert(addo,1);
            end;
        end;
        insertcursor;
    end
    else
    begin
        if direction=0 then
        begin
            if offset>0 then scrollinsert(addo,0);
        end
        else
        begin
            if offset+addo<bufferlength+1 then scrollinsert(addo,1);
        end;
    end;
    if curpos>7 then addo:=curpos-7 else addo:=0;
    if scrtypeflag=0 then for i:=4 to 11 do for j:=2 to 79 do smallscreen[i,j]:=screen[i+startline,j] else
    for i:=4 to 11 do for j:=2 to 79 do smallscreen[i,j]:=screen[i+addo,j];
    if scrtypeflag=0 then j:=10 else j:=lo(numrows)-1;
    for i:=5 to j do screen[i+sl,80].att:=$07;
    i:=(((curpos+offset)*(j-4)) div (bufferlength+1))+5;
    if i>j then i:=j;
    screen[i+sl,80].att:=$40;
end;

procedure keycommons;                                                    {General screen repaint}
begin
    if scrtypeflag=0 then
    begin
        makesmall(startline);
        if entrytype=1 then removecursor;
        i:=0;
        while ((i<bufferlength+1) and (i<8)) do
        begin
            writestring(2,4+i+startline,a1,1,78,scrollbuffer[i+offset]);inc(i);
        end;
        if i<8 then for i:=i to 7 do
        begin
            writestring(2,4+i+startline,a1,0,78,' ');
        end;
        for i:=4 to 11 do for j:=2 to 79 do smallscreen[i,j]:=screen[i+startline,j];
        if entrytype=1 then insertcursor;
    end
    else
    begin
        makelarge;
    end;
end;

procedure pgup;                                                                {Page up procedure for the text screen}
var addo:byte;
begin
    addo:=(scrtypeflag*13)+8;
    if scrtypeflag=1 then inc(addo,lo(numrows)-24);
    if entrytype=1 then
    begin
        if curpos>0 then
        begin
            removecursor;
            curpos:=1;
        end
        else
        begin
            dec(offset,addo-2);
            if ((offset<1) or (offset>10000)) then offset:=1;
        end;
    end
    else
    begin
        curpos:=0;
        dec(offset,addo-2);
        if ((offset<1) or (offset>10000)) then offset:=1;
    end;
    scroll(0);
end;

procedure pgdn;                                                                {Page down procedure for the text screen}
var addo:byte;
begin
    addo:=(scrtypeflag*13)+8;
    if scrtypeflag=1 then inc(addo,lo(numrows)-24);
    if entrytype=1 then
    begin
        if curpos<addo-1 then
        begin
            removecursor;
            curpos:=addo-2;
            if curpos>bufferlength-1 then curpos:=bufferlength-1;
        end
        else
        begin
            inc(offset,addo-2);
            if offset+addo>bufferlength then offset:=bufferlength-addo;
        end;
    end
    else
    begin
        curpos:=addo-1;
        inc(offset,addo-2);
        if offset+addo>bufferlength then offset:=bufferlength-addo;
        if offset>10000 then offset:=0;
    end;
    scroll(1);
end;

procedure getstreng;                                                    {Read string from keyboard and echo it on screen}
var chii:word;
        stl,sl:byte;
        chin:char;
begin
    if scrtypeflag=0 then sl:=startline else sl:=0;
    streng:='';stl:=0;
    writestring(15,4+sl,a1+128,0,0,#219);
    repeat
        keyread(chii);chin:=chr(lo(chii));
        if ((31<chii) and (chii<256) and (length(streng)<62)) then
        begin
            writestring(15+stl,4+sl,a1,0,0,upcase(chin));
            streng:=streng+upcase(chin);
            inc(stl);
            writestring(15+stl,4+sl,a1+128,0,0,#219);
        end;
        if ((chii=8) and (length(streng)>0)) then
        begin
            writestring(15+stl,4+sl,a1,0,0,#0);
            streng:=copy(streng,1,length(streng)-1);
            dec(stl);
            writestring(15+stl,4+sl,a1+128,0,0,#219);
        end;
    until ((chii=13) or (chii=27));
    if chii=27 then streng:='';
end;

procedure s_o_l_insert;                                                {Insert for the search-or-load procedure}
var savl:byte;
begin
    screen:=savedscreen;
    if scrtypeflag=1 then
    begin
        savl:=startline;
        startline:=0;
        createsmall;
        makelarge;
        startline:=savl;
    end
    else createsmall;
    insertcursor;
    makemenu(3);
end;

procedure exitmenus;                                                    {Remove pull-down menu}
var add:byte;
begin
    mlevel:=0;menuy:=0;wix:=0;wiy:=0;
    if scrtypeflag=0 then makesmall(startline) else
    begin
        for j:=1 to 80 do screen[3,j]:=smallscreen[3,j];
        i:=0;
        while ((i+offset<bufferlength+1) and (i<9)) do
        begin
            writestring(2,4+i,a1,1,78,scrollbuffer[i+offset]);inc(i);
        end;
        if entrytype=1 then insertcursor;
        for i:=5 to lo(numrows)-1 do screen[i,80].att:=$07;
        i:=(((curpos+offset)*(lo(numrows)-5)) div (bufferlength+1))+5;
        if i>lo(numrows)-1 then i:=lo(numrows)-1;
        screen[i,80].att:=$40;
    end;
end;

procedure search_or_load(typ:byte;namest:string);        {Search for entry or load new NG file}
var sl,savl:byte;
        tmpchr:word;
        savst:string;
begin
    if scrtypeflag=0 then sl:=startline else sl:=0;
    wix:=2;wiy:=2+sl;
    frame1(76,3);
    writestring(4,4+sl,a1,0,74,namest);
    savst:=streng;
    getstreng;
    if streng<>'' then
    begin
        if typ=0 then
        begin
{SEARCH begins - feel free to add this yourself}
            if scrtypeflag=0 then
            begin
                makesmall(startline);
            end
            else
            begin
                makelarge;
            end;
            wix:=0;wiy:=0;
{SEARCH ends - feel free to add this yourself}
        end
        else
        begin                                                                                            {Load new guide file}
            erro:=0;
            if pos('.',streng)=0 then streng:=streng+'.NG';
            if ((pos('\',streng)=0) and (pos(':',streng)=0)) then
            writestring(4,4+sl,a1,0,74,' Loading '+homedir+streng+' - please wait') else
            writestring(4,4+sl,a1,0,74,' Loading '+streng+' - please wait');
            close(f);
            twonitvars;
            if ((pos('\',streng)=0) and (pos(':',streng)=0)) then assign(f,homedir+streng) else assign(f,streng);
            reset(f,1);
            if ioresult<>0 then
            begin
                sllut(3);
            end;
            if erro=0 then
            begin
                read_header(1);
            end;
            if erro=0 then
            begin
                read_menus(1);
            end;
            if erro=0 then
            begin
                read_entry(mennu[0,1].filptr);
                s_o_l_insert;
            end
            else
            begin {If there are any errors, we reload the old guide file}
                keyread(tmpchr);
                streng:=savst;
                twonitvars;
                if ((pos('\',streng)=0) and (pos(':',streng)=0)) then assign(f,homedir+streng) else assign(f,streng);
                reset(f,1);
                read_header(1);
                read_menus(1);
                read_entry(mennu[0,1].filptr);
                s_o_l_insert;
            end;
        end;
    end
    else exitmenus;
end;

procedure escape_insert;                                            {Insert for the ESC key handler}
begin
    dec(level);
    read_entry(parent[level]);
    if ((level>0) or (entrytype=1)) then
    begin
        curpos:=pcurpos[level];offset:=poffset[level];
    end;
    sapos:=0;
    keycommons;
    ch:=0;
end;

procedure keyhandler; {Reads key from keyboard and decides which action to take}
var sl:byte;
        tmpchr,tmo,tmc:word;
begin
    repeat
        keyread(ch);
        case ch of
            43:        begin {'+' key - moves small screen one line down}
                            if scrtypeflag=0 then
                            begin
                                if startline<lo(numrows)-11 then
                                begin
                                    inc(startline);
                                    for i:=startline+11 downto startline do for j:=1 to 80 do screen[i+1,j]:=screen[i,j];
                                    for j:=1 to 80 do screen[startline,j]:=savedscreen[startline,j];
                                    if mlevel=1 then inc(wiy);
                                end;
                            end;
                        end;
            45:        begin {'-' key - moves small screen one line up}
                            if scrtypeflag=0 then
                            begin
                                if startline>0 then
                                begin
                                    dec(startline);
                                    for i:=startline to startline+11 do for j:=1 to 80 do screen[i+1,j]:=screen[i+2,j];
                                    for j:=1 to 80 do screen[13+startline,j]:=savedscreen[13+startline,j];
                                    if mlevel=1 then dec(wiy);
                                end;
                            end;
                        end;
            328:    if mlevel=0 then scroll(0) else        {UpArrow key}
                        begin
                            removemlcursor;
                            if menuy>0 then dec(menuy) else menuy:=itemlist[menux-3]-2;
                            insertmlcursor;
                        end;
            336:    if mlevel=0 then scroll(1) else        {DownArrow key}
                        begin
                            removemlcursor;
                            if menuy<itemlist[menux-3]-2 then inc(menuy) else menuy:=0;
                            insertmlcursor;
                        end;
            329:    if mlevel=0 then pgup;                        {PgUp key}
            337:    if mlevel=0 then pgdn;                        {PgDn key}
            327:    if entrytype=2 then                                {Home key - go to previous entry}
                        begin
                            if level>0 then
                            begin
                                if previous>0 then
                                begin
                                    read_entry(previous);
                                    curpos:=0;offset:=0;sapos:=0;
                                    keycommons;
                                end;
                            end;
                        end;
            335:    if entrytype=2 then                                {End key - go to next entry}
                        begin
                            if level>0 then
                            begin
                                if next>0 then
                                begin
                                    read_entry(next);
                                    curpos:=0;offset:=0;sapos:=0;
                                    keycommons;
                                end;
                            end;
                        end;
            331:    if mlevel=0 then                                    {LeftArrow key}
                        begin
                            if ((entrytype=1) or (level=0)) then movemenucursor(0) else moveseealso(0);
                        end
                        else
                        begin
                            exitmenus;
                            movemenucursor(0);
                        end;
            333:    if mlevel=0 then                                    {RightArrow key}
                        begin
                            if ((entrytype=1) or (level=0)) then movemenucursor(1) else moveseealso(1);
                        end
                        else
                        begin
                            exitmenus;
                            movemenucursor(1);
                        end;
            9    :        begin {Tab key - toggles between small and large screens}
                            if scrtypeflag=0 then
                            begin
                                scrtypeflag:=1;
                                makelarge;
                            end
                            else
                            begin
                                scrtypeflag:=0;
                                makesmall(startline);
                                if mlevel=1 then makemenu(menux);
                            end;
                        end;
            13:        if ((entrytype=1) or (level=0)) then        {ENTER key handler}
                        begin
                            if menux=0 then
                            begin
                                tmc:=curpos;tmo:=offset;
                                pcurpos[level]:=curpos;poffset[level]:=offset;
                                curpos:=0;offset:=0;
                                inc(level);
                                read_entry(infobuffer[tmc+tmo]);
                                keycommons;
                            end
                            else if menux=1 then
                            begin
                                search_or_load(0,' Look for:');
                            end
                            else if menux=2 then
                            begin
                                search_or_load(1,' New file:');
                            end
                            else
                            begin
                                if mlevel=0 then makemenu(menux)
                                else
                                begin
                                    read_entry(mennu[menux-3,menuy+1].filptr);
                                    if entrytype=2 then inc(level);
                                    xchoice:=menux-3;ychoice:=menuy;
                                    curpos:=0;offset:=0;mlevel:=0;menuy:=0;
                                    keycommons;
                                end;
                            end;
                        end
                        else
                        begin
                            if seealsonum<>255 then
                            begin
                                read_entry(seealso[sapos].filptr);
                                curpos:=0;offset:=0;sapos:=0;
                                keycommons;
                            end;
                        end;
            27:        if ((entrytype=2) and (level>0)) then        {ESC key handler}
                        begin
                            escape_insert;
                        end
                        else if mlevel=1 then
                        begin
                            exitmenus;
                            ch:=0;
                        end
                        else
                        begin
                            if level>0 then
                            begin
                                escape_insert;
                            end
                            else
                            begin
                                if scrtypeflag=0 then sl:=startline else sl:=0;
                                wix:=2;wiy:=2+sl;
                                frame1(40,3);
                                writestring(4,4+sl,a3,0,38,' Do you really want to quit (Y/N) ?');
                                repeat
                                    keyread(tmpchr);
                                until ((upcase(chr(lo(tmpchr)))='Y') or (upcase(chr(lo(tmpchr)))='N'));
                                writestring(40,4+sl,a3,0,0,upcase(chr(lo(tmpchr))));
                                i:=0;while i<65535 do inc(i);
                                if upcase(chr(lo(tmpchr)))='N' then
                                begin
                                    if scrtypeflag=0 then makesmall(startline) else makelarge;
                                    ch:=0;
                                end;
                            end;
                        end;
        end;
    until ch=27;
end;

function sizeofcode:word;                                            {TESS function to decide size of resident code}
var used:word;
begin
    used:=seg(heapptr^)-prefixseg;
    sizeofcode:=used;
end;

{$F+} procedure tsrmainproc; {$F-}                        {TESS resident procedure entry point}
begin
  if ((lo(screenmode)<4) or (lo(screenmode)=7)) then
  begin
    savedcsr:=csr;
      threenitvars;
      startline:=0;
      scrtypeflag:=0;
      read_entry(mennu[0,1].filptr);
      createsmall;
      insertcursor;
      makemenu(3);
      keyhandler;
      screen:=savedscreen;
      if restorecrsr(savedcsr) then i:=i;
  end
  else
  begin
    tessbeep;
  end;
end;

{$F+} procedure tsrcleanup(removetsr:boolean); {$F-}        {TESS install-or-remove procedure entry point}
begin
    if (removetsr) then
    begin
        close(f);
        erroraddr:=NIL;
    end
    else
    begin
        initscreen;
        read_header(0);
        read_menus(0);
        write('NG_CLONE installed                                            Hotkey: Ctrl-Alt-G');
    end;
end;

begin                                                                                    {Main loop and command-line parser}
    directvideo:=false;                                                    {Force write and writeln through BIOS}
    write('Norton Guides Clone V. 1.0                                 (c) 1989 J.P.Pedersen');
    initvars;                                                                        {Initialize global variables}
    tsrstring:='NG_CLONE';                                            {TESS ID string - rather original, eh?}
  tssetadrtp4(@tsrmainproc,2);                                {Set TESS entry point}
  tssetadrtp4(@tsrcleanup,5);                                    {Set TESS entry point}
    defptr:=NIL;                                                                {TESS stack pointer #1}
    stackptr:=@backstack[(sizeof(backstack)-3)];        {TESS stack pointer #2}
    tssetstack(defptr^,stackptr^);                            {Initialize TESS stacks}
  if (tscheckresident(tsrstring[1],idnum)=$FFFF) then        {Is NG_CLONE already resident?}
    begin
        if ((paramstr(1)='/U') or (paramstr(1)='/u')) then            {If uninstall command, then do so}
        begin
      writeln('NG_CLONE removed from memory');
      i:=tsrelease(idnum);
            halt(0);
        end
        else
        begin {Else report presence and exit}
            write('NG_CLONE already installed                                    Hotkey: Ctrl-Alt-G');
            halt(0);
        end;
    end
  else
  begin                                                                                                    {Else}
    if ((paramstr(1)='/U') or (paramstr(1)='/u')) then            {If program is not resident, it cannot be removed!}
    begin
      writeln('NG_CLONE has not been installed!');
      halt(0);
    end;
  end;
    if ((paramstr(1)='/?') or (paramstr(1)='/h') or (paramstr(1)='/H')) then slutlort(0);        {Write usage info and exit}
    if paramcount<2 then slutlort(1);                        {Command-line syntax error}
    if paramcount>3 then slutlort(2);                        {Command-line syntax error}
    streng:=paramstr(1);
    if paramcount=3 then homedir:=paramstr(2)+'\' else homedir:='';        {Check for ngdir entry on command-line}
    if pos('.',streng)=0 then streng:=streng+'.NG';        {Expand file name}
    if ((pos('\',streng)=0) and (pos(':',streng)=0)) then assign(f,homedir+streng) else assign(f,streng); {Expand further}
    reset(f,1);
    if ioresult<>0 then slutlort(3);                        {If file does not exist, terminate and write cause of death}
    if (paramstr(paramcount)='+') then                    {Should we go resident?}
    begin {OK, we let TESS do the hard work}
        if (tsdoinit(tsrhot_g,tsrpopalt+tsrpopctrl,tsrusepopup,sizeofcode)<>0) then writeln('Cannot install');
    end
    else if (paramstr(paramcount)='-') then                {Non-resident mode wanted}
    begin
    savedcsr:=csr;
        initscreen;
        read_header(0);
        read_menus(0);
        read_entry(mennu[0,1].filptr);
        createsmall;
        insertcursor;
        makemenu(3);
        keyhandler;
        screen:=savedscreen;
        close(f);
        if restorecrsr(savedcsr) then i:=i;
    end
    else slutlort(0); {If there is no (+/-) switch to determine mode , it is an error}
end.